home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 5 / Apprentice-Release5.iso / Source Code / Pascal / Applications / NIH Image 1.60 / 1.60 Source / Camera.p < prev    next >
Encoding:
Text File  |  1996-03-01  |  45.8 KB  |  1,688 lines  |  [TEXT/PJMM]
  1. unit Camera;
  2.  
  3. {Routines used by the NIH Image to support Data Translation
  4. and Scion (LG-3, AG-5 or VG-5) frame grabber cards, and
  5. QuickTime compatible digitizers.}
  6.  
  7. interface
  8.  
  9.  
  10.     uses
  11.         Types, Memory, QuickDraw, QuickDrawText, Packages, Menus, Events, Fonts, 
  12.         Scrap, ToolUtils, Resources, Errors, Palettes, StandardFile, Windows,
  13.         Controls, TextEdit, Files, Dialogs, TextUtils, Finder, MixedMode, Processes,
  14.         QDOffscreen, Components, QuickTimeComponents, ImageCompression, GestaltEqu, OSUtils,
  15.         globals, Utilities, Graphics, File1, Analysis, Lut;
  16.  
  17.  
  18.     function DoAveragingOptions: boolean;
  19.     procedure AverageFrames;
  20.     procedure GetFrame;
  21.     procedure CaptureAndDisplayFrame;
  22.     procedure HighlightPixels;
  23.     procedure ShowTriggerMessage;
  24.     procedure StartDigitizing;
  25.     procedure StopDigitizing;
  26.     function GetFGPixel (h, v: integer): integer;
  27.     procedure WaitForTrigger;
  28.     procedure ShowChannel;
  29.     procedure ShowVideoControl;
  30.     procedure UpdateVideoControl;
  31.     procedure DoVideoControl (item: integer);
  32.     procedure SelectCameraWindow;
  33.     procedure SetOffset (var offset, gain: integer);
  34.     procedure SetGain (var offset, gain: integer);
  35.     procedure ShowOffsetAndGain (offset, gain: integer);
  36.     procedure ShowVideoDialog;
  37.     procedure StartFrame;
  38.     procedure StopFrame;
  39.  
  40.  
  41.  
  42. implementation
  43.  
  44. type
  45.     IntPtr = ^integer;
  46.  
  47. var
  48.     SavePicBaseAddr: ptr;
  49.     StopFlagLoc: IntPtr;
  50.  
  51.  
  52. procedure GetGrabDepth(var bitDepth: LongInt);
  53. var
  54.     vdigInfo: DigitizerInfo;
  55. begin
  56.     if VDGetDigitizerInfo(vdig, vdigInfo) = noErr then begin
  57.         if DigitizerMode = digitizeGrayscale then begin
  58.             if band(vdigInfo.outputCapabilityFlags, digiOutDoes8) <> 0 then
  59.                 bitDepth := 8 {first choice}
  60.             else if band(vdigInfo.outputCapabilityFlags, digiOutDoes32) <> 0 then
  61.                 bitDepth := 32 {second choice}
  62.             else if (band(vdigInfo.outputCapabilityFlags, digiOutDoes16) <> 0) then
  63.                     bitDepth := 16; {last choice}
  64.         end else begin {capture color}
  65.             if band(vdigInfo.outputCapabilityFlags, digiOutDoes32) <> 0 then
  66.                 bitDepth := 32 {first choice}
  67.             else if band(vdigInfo.outputCapabilityFlags, digiOutDoes16) <> 0 then
  68.                 bitDepth := 16 {second choice}
  69.             else if (band(vdigInfo.outputCapabilityFlags, digiOutDoes8) <> 0) then
  70.                     bitDepth := 8; {last choice}
  71.         end;
  72.     end;
  73.     ShowMessage(StringOf('grab depth=', bitDepth));
  74. end;
  75.  
  76.  
  77. procedure SetVideoStandard;
  78. var
  79.     err: ComponentResult;
  80.     inFlags, outFlags: LongInt;
  81.     vdigInfo: DigitizerInfo;
  82. begin
  83.     if VDGetDigitizerInfo(vdig, vdigInfo) <> noErr then
  84.         exit(SetVideoStandard);
  85.     case DigitizerStandard of
  86.         NTSCStd: if band(vdigInfo.inputCapabilityFlags, digiInDoesNTSC) <> 0 then
  87.                         err := VDSetInputStandard(vdig, ntscIn);
  88.         PALStd: if band(vdigInfo.inputCapabilityFlags, digiInDoesPAL) <> 0 then
  89.                         err := VDSetInputStandard(vdig, palIn);
  90.         SECAMStd: if band(vdigInfo.inputCapabilityFlags, digiInDoesSECAM) <> 0 then
  91.                         err := VDSetInputStandard(vdig, secamIn);
  92.         otherwise;
  93.     end;
  94.     err := VDGetCurrentFlags(vdig, inFlags, outFlags);
  95.     if err = noErr then
  96.         if band(inFlags, digiInDoesNTSC) <> 0 then
  97.                         DigitizerStandard := NTSCStd
  98.         else if band(inFlags, digiInDoesPAL) <> 0 then
  99.                         DigitizerStandard := PALStd
  100.         else if band(inFlags, digiInDoesSECAM) <> 0 then
  101.                         DigitizerStandard := SECAMStd;
  102. end;
  103.  
  104.  
  105. procedure SetVideoInput;
  106. var
  107.     err: ComponentResult;
  108.     maxChannel, currentChannel: integer;
  109. begin
  110.     err := VDGetNumberOfInputs(vdig, maxChannel);
  111.     if (VideoChannel <= maxChannel) and (err = noErr) then
  112.         err := VDSetInput(vdig, VideoChannel)
  113.     else begin
  114.         VideoChannel := 0;
  115.         err := VDSetInput(vdig, 0);
  116.     end;
  117.     err := VDGetInput(vdig, currentChannel);
  118.     if err = noErr then
  119.         VideoChannel := currentChannel;
  120. end;
  121.  
  122.  
  123. function SetupVdig: boolean;
  124. var
  125.     mPtr: MatrixRecordPtr;
  126.     vdErr: ComponentResult;
  127.     vdigInfo: DigitizerInfo;
  128.     DummyMatrixRecord, bitDepth: LongInt;
  129.     err: OSErr;
  130.     flags: GWorldFlags;
  131.     SaveGDevice: GDHandle;
  132.     gwRect, srcRrect: rect;
  133.     str: str255;
  134. begin
  135.    SetupVdig := false;
  136.     SetRect(gwRect, 0, 0, fgWidth, fgHeight);
  137.     bitDepth := 8;
  138.     GetGrabDepth(bitDepth);
  139.     SetVideoInput;
  140.     if bitDepth = 8 then
  141.         vdErr := VDSetInputColorSpaceMode(vdig, 0); {grayscale}
  142.     SaveGDevice := GetGDevice;
  143.     SetGDevice(osGDevice);
  144.     if bitDepth = 8 then
  145.         GWorldLUT := GetCTable(40) {grayscale LUT}
  146.     else
  147.         GWorldLUT := nil;
  148.     flags := 0;
  149.     err := NewGWorld(osGWorld, bitDepth, gwRect, GWorldLUT, nil, flags);
  150.     SetGDevice(SaveGDevice);
  151.     if err <> NoErr then begin
  152.             PutMemoryAlert;
  153.             CloseVdig;
  154.             exit(SetupVdig);
  155.         end;
  156.     fgPixMap := GetGWorldPixMap(osGWorld);
  157.     if not LockPixels(fgPixMap) then begin
  158.             CloseVdig;
  159.             exit(SetupVdig);
  160.         end;
  161.     {err := LockMemoryContiguous(GetPixBaseAddr(fgPixMap), 2097152);}
  162.     vdErr := VDGetActiveSrcRect(vdig, 0, srcRrect);
  163.     if vdErr = noErr then
  164.         vdErr := VDSetDigitizerRect(vdig, srcRrect);
  165.     DummyMatrixRecord := LongInt(nil);
  166.     mPtr := MatrixRecordPtr(ptr(DummyMatrixRecord));
  167.     vdErr := VDSetPlayThruDestination(vdig, fgPixMap, gwRect, MatrixRecord(mPtr^), nil);
  168.     if vdErr = noErr then
  169.         SetupVdig := true
  170.     else begin
  171.         CloseVdig;
  172.         if vdErr = -2208 then
  173.             str := concat(cr, '(Try turning virtual memory or RAM Doubler off.)')
  174.         else
  175.             str := '';
  176.         PutError(StringOf('Video digitizer error ', vdErr, str));
  177.     end;
  178. end;
  179.  
  180.  
  181. procedure LookForVDig(var vdigError: boolean);
  182. {Look for a QuickTime video digitizer component}
  183. var
  184.     result: LongInt;
  185.     videoDesc: ComponentDescription;
  186.     srcRrect: rect;
  187.     vdErr: ComponentResult;
  188.     vdigID: Component;
  189. begin
  190.    vdigError := false;
  191.     if Gestalt(gestaltQuickTime, result) <> noErr then begin
  192.         ShowMessage('No QuickTime');
  193.         exit(LookForVDig);
  194.     end;
  195.     {$IFC PowerPC}
  196.     if Gestalt(gestaltQuickTimeFeatures, result) <> noErr then begin
  197.         ShowMessage('No QuickTime PPC support');
  198.         exit(LookForVDig);
  199.     end;
  200.     {$ENDC}
  201.     videoDesc.componentType := VideoDigitizerComponentType;
  202.     videoDesc.componentSubType := OSType(0); {any subtype}
  203.     if UseBuiltinDigitizer then
  204.         videoDesc.componentManufacturer := 'appl'
  205.     else
  206.         videoDesc.componentManufacturer := OSType(0);
  207.     videoDesc.componentFlags := 0;
  208.     videoDesc.componentFlagsMask := 0;
  209.     vdigID :=FindNextComponent(Component(0), videoDesc);
  210.     if vdigID = Component(0) then begin
  211.         videoDesc.componentManufacturer := OSType(0); {any manufacturer}
  212.         vdigID :=FindNextComponent(Component(0), videoDesc);
  213.         if vdigID = Component(0) then begin
  214.             ShowMessage('No vdig found');
  215.             exit(LookForVDig);
  216.         end;
  217.     end;
  218.     vdig := OpenComponent(vdigID);
  219.     if vdig = nil then begin
  220.       ShowMessage('Unable to open vdig');
  221.       vdigError := true;
  222.         exit(LookForVDig);
  223.     end;
  224.     SetVideoStandard;
  225.     vdErr := VDGetDigitizerRect(vdig, srcRrect);
  226.     {vdErr := VDGetActiveSrcRect(vdig, 0, srcRrect);}
  227.     if vdErr = noErr then with srcRrect do begin
  228.         fgWidth := (right - left) div fgScale;
  229.         fgHeight := (bottom - top) div fgScale;
  230.     end else begin
  231.         fgWidth := 320;
  232.         fgHeight := 240;
  233.     end;
  234.     FrameGrabber := QTvdig;
  235.     if not SetupVdig then
  236.         vdigError := true;
  237.     HighlightSaturatedPixels := false;
  238. end;
  239.  
  240.  
  241. procedure CorrectShadingOfLine (PicPtr, BFPtr: ptr; width, BFMean: integer);
  242. {$IFC PowerPC}
  243. VAR
  244.   PicLine,BFLine:LinePtr;
  245.   i,value:LongInt;
  246. BEGIN
  247.   PicLine:=LinePtr(PicPtr);
  248.   BFLine:=LinePtr(BFPtr);
  249.   FOR i:=0 TO width-1 DO BEGIN
  250.     value:=PicLine^[i];
  251.     value:=255-value;
  252.     value:=(value * BFMean + (BFLine^[i] div 2)) DIV BFLine^[i];
  253.     IF value>254 THEN value:=254;
  254.     IF value<1 THEN value:=1;
  255.     PicLine^[i]:=255-value;
  256.   END;
  257. END;
  258. {$ELSEC}
  259.   {a0=data pointer}
  260.   {a1=blank field data pointer}
  261.   {d0=count}
  262.   {d1=pixel value}
  263.   {d2=blank field pixel value}
  264.   {d3=blank field mean}
  265.   {d4=temp}
  266.   {d5=max pixel value(245)}
  267.   {d6=min pixel value(1)}
  268.     inline
  269.         $4E56, $0000, {   link    a6,#0}
  270.         $48E7, $FEC0, {   movem.l    a0-a1/d0-d6,-(sp)}
  271.         $206E, $000C, {   move.l    12(a6),a0}
  272.         $226E, $0008, {   move.l    8(a6),a1}
  273.         $4280,       {   clr.l    d0}
  274.         $302E, $0006, {   move.w    6(a6),d0}
  275.         $362E, $0004, {   move.w    4(a6),d3}
  276.         $2A3C, $0000, $00FE, {   move.l    #254,d5}
  277.         $2C3C, $0000, $0001, {   move.l    #1,d6}
  278.         $5380,       {   subq.l    #1,d0}
  279.         $4281,       {   clr.l    d1}
  280.         $4282,       {   clr.l    d2}
  281.         $1210,       {L1    move.b    (a0),d1}
  282.         $1419,       {   move.b    (a1)+,d2}
  283.         $4601,       {   not.b    d1}
  284.         $C2C3,       {   mulu.w    d3,d1}
  285.         $2802,       {   move.l    d2,d4}
  286.         $E244,       {   asr.w    #1,d4}
  287.         $D284,       {   add.l    d4,d1}
  288.         $82C2,       {   divu.w    d2,d1}
  289.         $B245,       {   cmp.w    d5,d1}
  290.         $6F02,       {   ble.s    L2}
  291.         $3205,       {   move.w    d5,d1}
  292.         $B246,       {L2    cmp.w    d6,d1}
  293.         $6C02,       {   bge.s    L3}
  294.         $3206,       {   move.w    d6,d1}
  295.         $4601,       {L3    not.b    d1}
  296.         $10C1,       {   move.b    d1,(a0)+}
  297.         $51C8, $FFDE, {   dbra    d0,L1}
  298.         $4CDF, $037F, {   movem.l    (sp)+,a0-a1/d0-d6}
  299.         $4E5E,       {   unlk    a6}
  300.         $DEFC, $000C; {   add.w    #12,sp}
  301. {$ENDC}
  302.  
  303.  
  304.     procedure CorrectShading;
  305.         var
  306.             i, tag, width: integer;
  307.             offset, NextUpdate: LongInt;
  308.             p1, p2: ptr;
  309.             str: str255;
  310.             MaskRect:rect;
  311.     begin
  312.         with info^ do begin
  313.                 if ImageSize <> BlankFieldInfo^.ImageSize then begin
  314.                         beep;
  315.                         exit(CorrectShading);
  316.                     end;
  317.                 ShowWatch;
  318.                 tag:=0;
  319.                 NextUpdate:=TickCount+6;
  320.                 width:=PicRect.right;
  321.                 p1 := PicBaseAddr;
  322.                 p2 := BlankFieldInfo^.PicBaseAddr;
  323.                 for i := 1 to nLines do begin
  324.                         CorrectShadingOfLine(p1, p2, PixelsPerLine, BlankFieldMean);
  325.                         p1 := ptr(ord4(p1) + info^.BytesPerRow);
  326.                         p2 := ptr(ord4(p2) + BlankFieldInfo^.BytesPerRow);
  327.                     if TickCount>=NextUpdate then begin
  328.                             SetRect(MaskRect, 0, tag, width, i);
  329.                             UpdateScreen(MaskRect);
  330.                             tag:=i;
  331.                             NextUpdate:=TickCount+6;
  332.                         end;
  333.                     end;
  334.                 SetRect(MaskRect, 0, tag, width, nLines);
  335.                 UpdateScreen(MaskRect);
  336.                 str := title;
  337.                 if SpatiallyCalibrated then
  338.                     str := concat(str, chr($13)); {Black Diamond}
  339.                 if fit <> uncalibrated then
  340.                     str := concat(str, '');
  341.                 if wptr <> nil then
  342.                     SetWTitle(wptr, concat(str, ' (Corrected)'));
  343.             end;
  344.     end;
  345.  
  346.  
  347.     procedure CopyVdigImageOffscreen;
  348.     var
  349.         SaveExtraColors: integer;
  350.     begin
  351.         with info^ do begin
  352.                 SaveExtraColors := 0;
  353.                 if (LUTMode = Grayscale) and (not IdentityFunction or (nExtraColors <> 0)) then begin
  354.                     SaveExtraColors := nExtraColors;
  355.                     nExtraColors := 0;
  356.                     ResetGrayMap;
  357.                 end;
  358.                 CopyOffscreen(fgPixMap, osPort^.portPixMap, PicRect, PicRect);
  359.                 if SaveExtraColors <> 0 then begin
  360.                     nExtraColors := SaveExtraColors;
  361.                     LoadLUT(ctable);
  362.                 end;
  363.                 UpdatePicWindow;
  364.         end; {with}
  365.     end;
  366.     
  367.     
  368.     procedure StartFrame;
  369.     begin
  370.         if CurrentBufferIsZero then
  371.             BufferReg^ := 0
  372.         else
  373.             BufferReg^ := 1;
  374.         if ExternalTrigger then
  375.             ControlReg^ := $90 {Start frame capture}
  376.         else
  377.             ControlReg^ := $80; {Start frame capture}
  378.     end;
  379.  
  380.  
  381.     procedure StopFrame;
  382.         var
  383.             ticks, timeout: LongInt;
  384.     begin
  385.         if ExternalTrigger then begin {Wait for trigger}
  386.                 repeat
  387.                     if button then
  388.                         ExternalTrigger := false;
  389.                 until (BitAnd(ControlReg^, $80) = $80) or not ExternalTrigger;
  390.                 ControlReg^ := 0;
  391.             end {if External Trigger}
  392.         else begin
  393.                 TimeOut := TickCount + 30;  {1/2sec. timeout}
  394.                 while BitAnd(ControlReg^, $80) = 0 do begin    {Wait for it to complete}
  395.                         if TickCount > TimeOut then begin
  396.                                 ControlReg^ := 0;
  397.                                 leave
  398.                             end;
  399.                     end;
  400.                 ControlReg^ := 0;
  401.             end;
  402.         with fgPort^ do
  403.             with PortPixMap^^ do
  404.                 if CurrentBufferIsZero then
  405.                     BaseAddr := ptr(fgSuperSlotBase0)
  406.                 else
  407.                     BaseAddr := ptr(fgSuperSlotBase1);
  408.         CurrentBufferIsZero := not CurrentBufferIsZero;
  409.         fgFrameCount := fgFrameCount + 1;
  410.     end;
  411.  
  412.  
  413.     procedure StopDigitizing;
  414.     begin
  415.         if digitizing then
  416.             with info^ do begin
  417.                     ShowFrameRate('', fgStartTicks, fgFrameCount);
  418.                     if vdig <> nil then
  419.                         CopyVdigImageOffscreen
  420.                     else
  421.                         CopyOffscreen(fgPixMap, osPort^.portPixMap, PicRect, PicRect);
  422.                     SetMenuItemText(SpecialMenuH, StartItem, 'Start Capturing');
  423.                     Digitizing := false;
  424.                     ContinuousHistogram := false;
  425.                     if DoubleBuffering then begin
  426.                         StopFrame;
  427.                         BufferReg^ := 0;
  428.                         CurrentBufferIsZero := true;
  429.                         DoubleBuffering := false;
  430.                         with fgPort^ do
  431.                             with PortPixMap^^ do
  432.                                 BaseAddr := ptr(fgSuperSlotBase0)
  433.                      end;
  434.                     with info^ do
  435.                         if PictureType = FrameGrabberType then begin
  436.                                 title := 'Camera';
  437.                                 UpdateTitleBar;
  438.                                 if HighlightSaturatedPixels then
  439.                                     LoadLUT(ctable);
  440.                             end;
  441.                     if (ScreenDepth<>8) and HighlightSaturatedPixels then
  442.                         UpdatePicWindow;
  443.                     if (BlankFieldInfo <> nil) and not OptionKeyDown then
  444.                         CorrectShading;
  445.                 end;
  446.     end;
  447.  
  448.  
  449.     procedure GetFrame;
  450.         var
  451.             ticks, timeout: LongInt;
  452.             temp:integer;
  453.             vdigErr: ComponentResult;
  454.     begin
  455.             case FrameGrabber of
  456.             
  457.                 ScionLG3, ScionVG5f:
  458.                     if ExternalTrigger then begin {Wait for trigger}
  459.                             ControlReg^ := $90;
  460.                             repeat
  461.                                 if button then
  462.                                     ExternalTrigger := false;
  463.                             until (band(ControlReg^, $80) = $80) or not ExternalTrigger;
  464.                             ControlReg^ := 0;
  465.                             if Digitizing then
  466.                                 StopDigitizing;
  467.                             UpdateVideoControl;
  468.                         end {if External Trigger}
  469.                     else begin
  470.                             TimeOut := TickCount + 30;  {1/2sec. timeout}
  471.                             ControlReg^ := $80; {Start frame capture}
  472.                             while band(ControlReg^, $80) = 0 do begin    {Wait for it to complete}
  473.                                     if TickCount > TimeOut then begin
  474.                                             ControlReg^ := 0;
  475.                                             leave
  476.                                         end;
  477.                                 end;
  478.                             ControlReg^ := 0;
  479.                         end;
  480.                 
  481.             ScionAG5:
  482.                     if ExternalTrigger then begin {Wait for trigger}
  483.                             ControlReg^ := bor(bor(ord(AG5GrabMode), $90), bsl(ord(AG5LutMode and not ControlKeyDown), 2));
  484.                             repeat
  485.                                 if button then
  486.                                     ExternalTrigger := false;
  487.                             until (band(ControlReg^, $80) = $80) or not ExternalTrigger;
  488.                             ControlReg^ := 0;
  489.                             if Digitizing then
  490.                                 StopDigitizing;
  491.                             UpdateVideoControl;
  492.                         end {if External Trigger}
  493.                     else begin
  494.                             TimeOut := TickCount + 30;  {1/2sec. timeout}
  495.                             ControlReg^ := bor(bor(ord(AG5GrabMode), $80), bsl(ord(AG5LutMode and not ControlKeyDown), 2)); {Start frame capture}
  496.                             repeat
  497.                                 if TickCount > TimeOut then
  498.                                     leave;
  499.                                 temp:=ControlReg^; {ppc-bug}
  500.                             until band(temp, $80) <> 0; {Wait for it to complete}
  501.                             ControlReg^ := 0;
  502.                         end;
  503.                         
  504.             QuickCapture:
  505.                 if ExternalTrigger then begin {Wait for trigger}
  506.                         ControlReg^ := $82; {Set Busy and External Trigger Enable bits}
  507.                         repeat
  508.                             if button then
  509.                                 ExternalTrigger := false;
  510.                             temp:=ControlReg^; {ppc-bug}
  511.                         until (band(temp, $80) = 0) or not ExternalTrigger;
  512.                         if Digitizing then
  513.                             StopDigitizing;
  514.                         UpdateVideoControl;
  515.                     end {if External Trigger}
  516.                 else begin
  517.                         TimeOut := TickCount + 30;  {1/2sec. timeout}
  518.                         ControlReg^ := $80; {Start frame capture by setting busy bit}
  519.                         repeat
  520.                             if TickCount > TimeOut then
  521.                                 leave;
  522.                             temp:=ControlReg^; {ppc-bug}
  523.                         until band(temp, $80) = 0; {Wait for frame capture to complete}
  524.                     end;
  525.             
  526.             QTvdig: begin
  527.                             if ExternalTrigger then begin {Wait for mouse press}
  528.                                 repeat
  529.                                 until button;
  530.                                 ExternalTrigger := false;
  531.                             end;
  532.                             if vdig <> nil then
  533.                                 vdigErr := VDGrabOneFrame(vdig);
  534.                     end;
  535.                 
  536.         end; {case}
  537.         fgFrameCount := fgFrameCount + 1;
  538.     end;
  539.  
  540.  
  541.     procedure CaptureAndDisplayFrame;
  542.         var
  543.             tPort: GrafPtr;
  544.             SaveGDevice: GDHandle;
  545.     begin
  546.         with info^ do begin
  547.                 if (PictureType <> FrameGrabberType) or (PixelsPerLine <> fgWidth) or (nlines <> fgHeight) then begin
  548.                         Digitizing := false;
  549.                         exit(CaptureAndDisplayFrame);
  550.                     end;
  551.                 if DoubleBuffering then begin
  552.                     StopFrame;
  553.                     StartFrame;
  554.                  end else
  555.                     GetFrame;
  556.                 SaveGDevice := GetGDevice;
  557.                 SetGDevice(GetMainDevice);
  558.                 getPort(tPort);
  559.                 SetPort(wptr);
  560.                 SetFColor(BlackIndex);
  561.                 SetBColor(WhiteIndex);
  562.                 if (FrameGrabber = QTvdig) and (LUTMode <> grayscale) and (ScreenDepth <= 8) then
  563.                     CopyBits(BitMapHandle(fgPixMap)^^, BitMapHandle(CGrafPtr(wptr)^.PortPixMap)^^, SrcRect, wrect, ditherCopy, nil)
  564.                 else
  565.                     CopyBits(BitMapHandle(fgPixMap)^^, BitMapHandle(CGrafPtr(wptr)^.PortPixMap)^^, SrcRect, wrect, srcCopy, nil);
  566.                 SetPort(tPort);
  567.                 SetGDevice(SaveGDevice);
  568.             end;
  569.     end;
  570.  
  571.  
  572.     procedure SetReg (index, value: integer);
  573.         const
  574.             RegOffset = $f5fe0;
  575.         var
  576.             reg: ptr;
  577.     begin
  578.         reg := ptr(fgSlotBase + RegOffset + index * 4);
  579.         reg^ := value;
  580.     end;
  581.  
  582.  
  583.     {$ifc PowerPC} {ppc-bug}
  584.     procedure SwapMMUMode(var mode:SignedByte);
  585.     begin
  586.     end;
  587.     {$endc}
  588.     
  589.     
  590.     procedure SelectCameraWindow;
  591.   {If there is a Camera window, activate it, otherwise, do nothing.}
  592.         var
  593.             i: integer;
  594.             TempInfo: InfoPtr;
  595.     begin
  596.         for i := 1 to nPics do begin
  597.                 TempInfo := pointer(WindowPeek(PicWindow[i])^.RefCon);
  598.                 if TempInfo^.PictureType = FrameGrabberType then begin
  599.                         if PicWindow[i] <> nil then begin
  600.                                 if OpPending then
  601.                                     KillRoi;
  602.                                 SelectWindow(PicWindow[i]);
  603.                                 Info := TempInfo;
  604.                                 ActivateWindow;
  605.                             end; {if}
  606.                         leave;
  607.                     end; {if}
  608.             end; {for}
  609.     end;
  610.  
  611.  
  612.     procedure HighlightPixels;
  613.         var
  614.             lut: MyCSpecArray;
  615.     begin
  616.         with info^ do begin
  617.                 lut := ctable;
  618.                 lut[1].rgb := Highlight1;
  619.                 lut[254].rgb := Highlight254;
  620.                 LoadLUT(lut);
  621.             end;
  622.     end;
  623.  
  624.  
  625.     procedure ShowTriggerMessage;
  626.     begin
  627.         if ExternalTrigger and (frameGrabber <> noFrameGrabber) then
  628.             ShowMessage(concat('EXTERNAL TRIGGER MODE', crStr, '(Press mouse button to exit)'));
  629.     end;
  630.  
  631.  
  632.     procedure StartDigitizing;
  633.         var
  634.             i, width, height: integer;
  635.             trect: rect;
  636.             NewWindow: boolean;
  637.             vdigError: boolean;
  638.     begin
  639.         if FrameGrabber = NoFrameGrabber then begin
  640.             LookForVDig(vdigError);
  641.             if vdigError then
  642.                 exit(StartDigitizing);
  643.         end;
  644.         if FrameGrabber = NoFrameGrabber then begin
  645.                 PutError('Capturing requires a Data Translation, Scion or QuickTime compatible frame grabber.');
  646.                 AbortMacro;
  647.                 exit(StartDigitizing)
  648.             end;
  649.         if Digitizing then begin
  650.                 StopDigitizing;
  651.                 if BlankFieldInfo <> nil then
  652.                     wait(15);
  653.                 FlushEvents(EveryEvent, 0); {In case user holds key down too long}
  654.                 exit(StartDigitizing)
  655.             end;
  656.         if info^.PictureType <> FrameGrabberType then
  657.             SelectCameraWindow;
  658.         NewWindow := false;
  659.         with info^ do
  660.             if (PictureType <> FrameGrabberType) or (PixelsPerLine <> fgWidth) or (nlines <> fgHeight) then begin
  661.                     if not NewPicWindow('Camera', fgWidth, fgHeight) then
  662.                         exit(StartDigitizing);
  663.                     if FrameGrabber = QTvdig then with info^ do begin
  664.                         fgPort := osPort;
  665.                         fgSlotBase := LongInt(PicBaseAddr);
  666.                         fgRowBytes := BytesPerRow;
  667.                     end;
  668.                     NewWindow := true;
  669.                 end;
  670.         with info^ do begin
  671.                 PictureType := FrameGrabberType;
  672.                 if NewWindow and (not EqualRect(SrcRect, PicRect)) then {Center Frame}
  673.                     with SrcRect do begin
  674.                             width := right - left;
  675.                             height := bottom - top;
  676.                             left := (PicRect.right - width) div 2;
  677.                             right := left + width;
  678.                             top := (PicRect.bottom - height) div 2;
  679.                             bottom := top + height;
  680.                         end;
  681.                 KillRoi;
  682.                 if ScaleToFitWindow then
  683.                     ScaleToFit;
  684.                 with SrcRect do begin
  685.                         width := right - left;
  686.                         left := band(left, $fffc);
  687.                         right := left + width;
  688.                     end;
  689.                 GetWindowRect(wptr, trect);
  690.                 with trect do
  691.                     if band(left, 3) <> 0 then
  692.                         MoveWindow(wptr, band(left, $fffc), top, true); {Forces window to be word aligned}
  693.                 with SrcRect do {Prevents bus errors when Camera window moved.}
  694.                     if (top = 0) and (bottom < PicRect.bottom) then begin
  695.                             top := top + 1;
  696.                             bottom := bottom + 1;
  697.                         end;
  698.                 ResetFrameGrabber;
  699.                 Digitizing := true;
  700.                 SetMenuItemText(SpecialMenuH, StartItem, 'Stop Capturing');
  701.                 changes := true;
  702.                 BinaryPic := false;
  703.                 UpdateTitleBar;
  704.                 if HighlightSaturatedPixels then
  705.                     HighlightPixels;
  706.             end; {with info}
  707.         fgFrameCount := 0;
  708.         fgStartTicks := TickCount;
  709.         ContinuousHistogram := false;
  710.         ShowTriggerMessage;
  711.         if PCIFramegrabber and not ExternalTrigger then begin
  712.             DoubleBuffering := true;
  713.             CurrentBufferIsZero := true;
  714.             StartFrame;
  715.         end;
  716.     end;
  717.  
  718.  
  719.     procedure AddLineToSum (src, dst: ptr; width: LongInt);
  720. {$IFC PowerPC}
  721.         type
  722.             SumLineType = array[0..2047] of integer;
  723.             fptr = ^SumLineType;
  724.         var
  725.             FrameLine: LinePtr;
  726.             SumLine: fptr;
  727.             i: integer;
  728.     begin
  729.         FrameLine := LinePtr(src);
  730.         SumLine := fptr(dst);
  731.         for i := 0 to width - 1 do
  732.             SumLine^[i] := SumLine^[i] + FrameLine^[i];
  733.     end;
  734. {$ELSEC}
  735. inline
  736. {a0=data pointer}
  737. {a1=sum buffer pointer}
  738. {d0=count}
  739. {d1=pixel value}
  740. {d2=temp}
  741.     $4E56, $0000, {link    a6,#0}
  742.     $48E7, $E0C0, {movem.l    a0-a1/d0-d2,-(sp)}
  743.     $206E, $000C, {move.l    12(a6),a0}
  744.     $226E, $0008, {move.l    8(a6),a1}
  745.     $202E, $0004, {move.l    4(a6),d0}
  746.     $5380,              {subq.l    #1,d0}
  747.     $4281,              {clr.l    d1}
  748.     $4282,              {clr.l    d2}
  749.     $1218,              {L1    move.b    (a0)+,d1}
  750.     $3411,              {move.w    (a1),d2}
  751.     $D441,              {add.w      d1,d2}
  752.     $32C2,              {move.w    d2,(a1)+}
  753.     $51C8, $FFF6, {dbra    d0,L1}
  754.     $4CDF, $0307, {movem.l    (sp)+,a0-a1/d0-d2}
  755.     $4E5E,               {unlk    a6}
  756.     $DEFC, $000C; {add.w    #12,sp}
  757. {$ENDC}
  758.  
  759.  
  760. function DoAveragingOptions: boolean;
  761.     const
  762.         FramesID = 8;
  763.         VideoRateID = 9;
  764.         SumID = 10;
  765.         ShowID = 11;
  766.         FixID = 12;
  767.         MinID = 13;
  768.         MaxID = 14;
  769.         OnChipID = 15;
  770.     var
  771.         mylog: DialogPtr;
  772.         item, i: integer;
  773. begin
  774.     InitCursor;
  775.     mylog := GetNewDialog(140, nil, pointer(-1));
  776.     if not SumFrames then begin
  777.             ShowIntegratedValues := false;
  778.             FixIntegrationScale := false;
  779.         end;
  780.     SetDNum(MyLog, FramesID, FramesToAverage);
  781.     SetDlogItem(mylog, SumID, ord(SumFrames));
  782.     SetDlogItem(mylog, VideoRateID, ord(VideoRateAveraging));
  783.     SetDlogItem(mylog, ShowID, ord(ShowIntegratedValues));
  784.     SetDlogItem(mylog, FixID, ord(FixIntegrationScale));
  785.     SetDlogItem(mylog, OnChipID, ord(IntegrateOnChip));
  786.     SetDNum(MyLog, MinID, IntegrationMin);
  787.     SetDNum(MyLog, MaxID, IntegrationMax);
  788.     SelectDialogItemText(MyLog, FramesID, 0, 32767);
  789.     repeat
  790.         ModalDialog(nil, item);
  791.         if item = FramesID then
  792.             FramesToAverage := GetDNum(MyLog, FramesID);
  793.         if item = SumID then begin
  794.                 SumFrames := not SumFrames;
  795.                 if SumFrames then
  796.                     IntegrateOnChip := false
  797.                 else begin
  798.                         FixIntegrationScale := false;
  799.                         ShowIntegratedValues := false;
  800.                     end;
  801.                 SetDlogItem(mylog, SumID, ord(SumFrames));
  802.                 SetDlogItem(mylog, FixID, ord(FixIntegrationScale));
  803.                 SetDlogItem(mylog, ShowID, ord(ShowIntegratedValues));
  804.                 SetDlogItem(mylog, OnChipID, ord(IntegrateOnChip));
  805.             end;
  806.         if item = VideoRateID then begin
  807.                 VideoRateAveraging := not VideoRateAveraging;
  808.                 if VideoRateAveraging then
  809.                     IntegrateOnChip := false;
  810.                 SetDlogItem(mylog, VideoRateID, ord(VideoRateAveraging));
  811.                 SetDlogItem(mylog, OnChipID, ord(IntegrateOnChip));
  812.             end;
  813.         if item = ShowID then begin
  814.                 ShowIntegratedValues := not ShowIntegratedValues;
  815.                 if ShowIntegratedValues then begin
  816.                         SumFrames := true;
  817.                         IntegrateOnChip := false;
  818.                     end;
  819.                 SetDlogItem(mylog, ShowID, ord(ShowIntegratedValues));
  820.                 SetDlogItem(mylog, SumID, ord(SumFrames));
  821.                 SetDlogItem(mylog, OnChipID, ord(IntegrateOnChip));
  822.             end;
  823.         if item = FixID then begin
  824.                 FixIntegrationScale := not FixIntegrationScale;
  825.                 if FixIntegrationScale then begin
  826.                         SumFrames := true;
  827.                         IntegrateOnChip := false;
  828.                     end;
  829.                 SetDlogItem(mylog, FixID, ord(FixIntegrationScale));
  830.                 SetDlogItem(mylog, SumID, ord(SumFrames));
  831.                 SetDlogItem(mylog, OnChipID, ord(IntegrateOnChip));
  832.             end;
  833.         if (item = MinID) or (item = MaxID) then begin
  834.                 if item = MinID then
  835.                     IntegrationMin := GetDNum(MyLog, MinID)
  836.                 else
  837.                     IntegrationMax := GetDNum(MyLog, MaxID);
  838.                 SumFrames := true;
  839.                 FixIntegrationScale := true;
  840.                 IntegrateOnChip := false;
  841.                 SetDlogItem(mylog, SumID, ord(SumFrames));
  842.                 SetDlogItem(mylog, FixID, ord(FixIntegrationScale));
  843.                 SetDlogItem(mylog, OnChipID, ord(IntegrateOnChip));
  844.             end;
  845.         if item = OnChipID then begin
  846.                 IntegrateOnChip := not IntegrateOnChip;
  847.                 if IntegrateOnChip then begin
  848.                         SumFrames := false;
  849.                         VideoRateAveraging := false;
  850.                         FixIntegrationScale := false;
  851.                         ShowIntegratedValues := false;
  852.                     end;
  853.                 SetDlogItem(mylog, OnChipID, ord(IntegrateOnChip));
  854.                 SetDlogItem(mylog, SumID, ord(SumFrames));
  855.                 SetDlogItem(mylog, VideoRateID, ord(VideoRateAveraging));
  856.                 SetDlogItem(mylog, FixID, ord(FixIntegrationScale));
  857.                 SetDlogItem(mylog, ShowID, ord(ShowIntegratedValues));
  858.             end;
  859.     until (item = ok) or (item = cancel);
  860.     DisposeDialog(mylog);
  861.     if FramesToAverage < 2 then
  862.         FramesToAverage := 2;
  863.     if IntegrationMin < 0 then
  864.         IntegrationMin := 0;
  865.     if IntegrationMax > 32767 then
  866.         IntegrationMax := 32767;
  867.     if VideoRateAveraging and (item <> cancel) then begin
  868.             if (FrameGrabber <> ScionLG3) and (FrameGrabber <> ScionAG5) then begin
  869.                     VideoRateAveraging := false;
  870.                     PutError('Video rate averaging or summation requires a Scion LG-3 or a Scion AG-5.');
  871.                     DoAveragingOptions := false;
  872.                     exit(DoAveragingOptions);
  873.                 end;
  874.             if (FrameGrabber = ScionLG3) and (FramesToAverage > MaxLG3Frames) then begin
  875.                     FramesToAverage := MaxLG3Frames;
  876.                     DoAveragingOptions := false;
  877.                     PutError(concat('This ', long2str(MaxLG3Frames div 2), 'MB LG-3 can capture a maximum of ', long2str(MaxLG3Frames), ' frames at video rates.'));
  878.                     exit(DoAveragingOptions);
  879.                 end;
  880.             if (FrameGrabber = ScionAG5) and (FramesToAverage > 127) then begin
  881.                     FramesToAverage := 127;
  882.                     DoAveragingOptions := false;
  883.                     PutError(concat('The AG-5 can average or sum a maximum of 127 frames at video rates.'));
  884.                     exit(DoAveragingOptions);
  885.                 end;
  886.         end;
  887.     if IntegrateOnChip and (item <> cancel) then
  888.         if (FrameGrabber <> ScionLG3) and (FrameGrabber <> ScionAG5) and (FrameGrabber <> ScionVG5f)  then begin
  889.                 IntegrateOnChip := false;
  890.                 PutError('On-chip integration requires a Scion frame grabber.');
  891.                 DoAveragingOptions := false;
  892.                 exit(DoAveragingOptions);
  893.             end;
  894.     DoAveragingOptions := item <> cancel;
  895. end;
  896.  
  897.  
  898.  
  899. function OddEven: boolean;
  900. {Looks at the the Field Status bit of the Status Register,
  901. which has the same address as Control Register 1. This bit is
  902. high during the odd field and low during the even field.}
  903. begin
  904.  if band(ControlReg^, $10) = $10 then
  905.   OddEven := true
  906.  else
  907.   OddEven := false;
  908. end;
  909.  
  910.  
  911. procedure WaitForOdd;
  912.  var
  913.   timeout: LongInt;
  914. begin
  915.  TimeOut := TickCount + 30;  {1/2sec. timeout}
  916.  while OddEven do
  917.   if TickCount > TimeOut then
  918.    Exit(WaitForOdd);
  919.  TimeOut := TickCount + 30;  {1/2sec. timeout}
  920.  while not OddEven do
  921.   if TickCount > TimeOut then
  922.    Exit(WaitForOdd);
  923. end;
  924.  
  925.  
  926. procedure IntegrateOn;
  927. {Sets bit 3 (Open Drain Output) of Control Register 1 high
  928. which pulls pin 11 of the 15 pin connector low, causing the
  929. Cohu camera to start integrating.}
  930. begin
  931.  ControlReg^ := $08;
  932. end;
  933.  
  934.  
  935. procedure IntegrateOff;
  936. {Sets bit 3 of Control Register 1 low which open circuits
  937.  pin 11, causing the Cohu camera to stop integrating.}
  938. begin
  939.  ControlReg^ := $00;
  940. end;
  941.  
  942.  
  943. procedure DoOnChipIntegration;
  944. {Requires a Scion LG-3, a Cohu 4910 series camera, and a cable available from Scion.}
  945. var
  946.     i,StartTicks:LongInt;
  947.     str:str255;
  948. begin
  949.     WaitForOdd;
  950.     IntegrateOn;
  951.     StartTicks := TickCount;
  952.     for i := 1 to FramesToAverage - 1 do begin
  953.         WaitForOdd;
  954.         if (i mod 30) = 0 then
  955.             ShowAnimatedWatch;
  956.         if CommandPeriod then
  957.             leave;
  958.     end;
  959.     IntegrateOff;
  960.     GetFrame;
  961.     RealToString((TickCount - StartTicks) / 60.0, 1, 2, str);
  962.     ShowFrameRate(concat(Long2str(FramesToAverage), ' frames', cr, str, ' seconds', cr), StartTicks, FramesToAverage);
  963.     with info^ do
  964.         CopyOffscreen(fgPixMap, osPort^.portPixMap, RoiRect, RoiRect);
  965.     UpdatePicWindow;
  966.     KillRoi;
  967.     if BlankFieldInfo <> nil then
  968.         CorrectShading;
  969.     if info^.fit<>uncalibrated then
  970.         RemoveDensityCalibration;
  971. end;
  972.  
  973.  
  974. procedure DoHardwareAveraging;
  975. {Do averaging or integration at video rates using the Scion Ag-5.}
  976. var
  977.   StartTicks,ActualMin,ActualMax:LongInt;
  978.   str1,str2:str255;
  979.   frame,i:integer;
  980.   roi:rect;
  981. begin
  982.     roi:=info^.RoiRect;
  983.     KillRoi;
  984.     if FramesToAverage > 127 then
  985.         FramesToAverage := 127;
  986.     ExternalTrigger := false;
  987.     AG5GrabMode := GrabNormal;
  988.     GetFrame;
  989.     StartTicks := TickCount;
  990.     AG5GrabMode := GrabSum;
  991.     for frame := 1 to FramesToAverage - 1 do begin
  992.             GetFrame;
  993.         end;
  994.     RealToString((TickCount - StartTicks) / 60.0, 1, 2, str2);
  995.     if not SumFrames then begin
  996.             ConstantReg^ := FramesToAverage;
  997.             AG5GrabMode := GrabDivide;
  998.             GetFrame;
  999.             AG5GrabMode := GrabNormal;
  1000.             str1 := '';
  1001.         end
  1002.     else begin
  1003.             ActualMin := Ord4(ScaleLowReg^);
  1004.             ActualMax := Ord4(ScaleHighReg^);
  1005.             if FixIntegrationScale then begin
  1006.                     ScaleLowReg^ := integer(IntegrationMin);
  1007.                     ScaleHighReg^ := integer(IntegrationMax);
  1008.                 end;
  1009.             AG5GrabMode := GrabScale;
  1010.             GetFrame;
  1011.             AG5GrabMode := GrabNormal;
  1012.             if FixIntegrationScale then
  1013.                 str1 := concat('min=', long2str(IntegrationMin), ' (', long2str(ActualMin), ')', cr, 'max=', long2str(IntegrationMax), ' (', long2str(ActualMax), ')', cr)
  1014.             else
  1015.                 str1 := concat('min=', long2str(ActualMin), cr, 'max=', long2str(ActualMax), cr)
  1016.         end;
  1017.     ShowFrameRate(concat(Long2str(FramesToAverage), ' frames', cr, str1, str2, ' seconds', cr), StartTicks, FramesToAverage);
  1018.     with info^ do
  1019.         CopyOffscreen(fgPixMap, osPort^.portPixMap, roi, roi);
  1020.     UpdatePicWindow;
  1021.     if not EqualRect(roi, info^.PicRect) then
  1022.         RestoreRoi;
  1023.     if BlankFieldInfo <> nil then
  1024.         CorrectShading;
  1025.     if ShowIntegratedValues then with info^ do begin
  1026.             fit := StraightLine;
  1027.             nCoefficients := 2;
  1028.             coefficient[2] := (ActualMax - ActualMin) / 253.0;
  1029.             coefficient[1] := ActualMin - coefficient[2];
  1030.             ZeroClip := false;
  1031.             UpdateTitleBar;
  1032.             if macro then
  1033.                 GenerateValues;
  1034.         end else
  1035.             if SumFrames and (info^.fit<>uncalibrated) then
  1036.                 RemoveDensityCalibration;
  1037.     end; {DoAG5HardwareAveraging}
  1038.     
  1039.  
  1040. procedure AverageFrames;
  1041.     type
  1042.         IntPtr = ^integer;
  1043.         SumLineType = array[0..2047] of integer;
  1044.         sptr = ^SumLineType;
  1045.     var
  1046.         AutoSelectAll: boolean;
  1047.         SelectionSize, FrameBufferSize, offset, StartTicks: LongInt;
  1048.         SumBase, src, srcbase, dst, OffscreenBase: ptr;
  1049.         str1, str2: str255;
  1050.         xLines, xPixelsPerLine, BytesPerLine, frame, line, pixel: integer;
  1051.         aline, BlankLine: LineType;
  1052.         GrabRect: rect;
  1053.         hstart, vstart, wwidth, wheight: integer;
  1054.         j, FramesAveraged: integer;
  1055.         SrcRowBytes, DstRowBytes, i, value, MinV, MaxV, range, ActualMin, ActualMax: LongInt;
  1056.         iptr: IntPtr;
  1057.         FrameLine: LinePtr;
  1058.         SumLine: sptr;
  1059.         SaveBlankFieldInfo: InfoPtr;
  1060.         myMMUMode: signedbyte;
  1061. begin
  1062.     with info^ do
  1063.         if PictureType <> FrameGrabberType then begin
  1064.                 PutError('You must have an active Camera window (created using Start Capturing) in order to average frames.');
  1065.                 AbortMacro;
  1066.                 exit(AverageFrames)
  1067.             end;
  1068.     if NotRectangular or NotinBounds then begin
  1069.             AbortMacro;
  1070.             exit(AverageFrames);
  1071.         end;
  1072.     if (not OptionKeyWasDown) and (not macro) then begin
  1073.             if not DoAveragingOptions then
  1074.                 exit(AverageFrames);
  1075.         end;
  1076.     SaveBlankFieldInfo := BlankFieldInfo;
  1077.     BlankFieldInfo := nil; {We don't want to do shading correction now}
  1078.     StopDigitizing;
  1079.     BlankFieldInfo := SaveBlankFieldInfo;
  1080.     OptionKeyWasDown := false;
  1081.     if (FrameGrabber <> ScionLG3) and (FrameGrabber <> ScionAG5) then
  1082.         VideoRateAveraging := false;
  1083.     if (FrameGrabber <> ScionLG3) and (FrameGrabber <> ScionAG5) and (FrameGrabber <> ScionVG5f) then
  1084.         IntegrateOnChip := false;
  1085.     ShowWatch;
  1086.     ShowTriggerMessage;
  1087.     AutoSelectAll := not Info^.RoiShowing;
  1088.     if AutoSelectAll then
  1089.         SelectAll(false);
  1090.     WhatToUndo := NothingToUndo;
  1091.     ContinuousHistogram := false;
  1092.     ResetFrameGrabber;
  1093.     if IntegrateOnChip then begin
  1094.         DoOnChipIntegration;
  1095.         exit(AverageFrames);
  1096.     end;
  1097.     if VideoRateAveraging and (FrameGrabber=ScionAg5) then begin
  1098.         DoHardwareAveraging;
  1099.         exit(AverageFrames);
  1100.     end;
  1101.     DrawLabels('Frame:', 'Total:', '');
  1102.     with info^.RoiRect do
  1103.         SelectionSize := (ord4(right) - left) * (bottom - top);
  1104.     FrameBufferSize := SelectionSize * 2;
  1105.     if FrameBufferSize > BigBufSize then begin
  1106.             NumToString(FrameBufferSize div 1024, str1);
  1107.             NumToString(BigBufSize div 1024, str2);
  1108.             str2 := concat(str1, 'K bytes are required, but only ', str2, 'K bytes are available.');
  1109.             PutError(concat('There is not enough memory to do the requested frame averaging. ', str2));
  1110.             if AutoSelectAll or (BlankFieldInfo <> nil) then
  1111.                 KillRoi
  1112.             else
  1113.                 ShowRoi;
  1114.             exit(AverageFrames)
  1115.         end;
  1116.     WhatsOnClip := NothingOnClip;
  1117.     SumBase := BigBuf;
  1118.     with info^, info^.RoiRect do begin
  1119.             offset := left + ord4(top) * BytesPerRow;
  1120.             OffscreenBase := ptr(ord4(PicBaseAddr) + offset);
  1121.             offset := left + ord4(top) * fgRowBytes;
  1122.             srcbase := ptr(ord4(ptr(fgSlotBase)) + offset);
  1123.             SrcRowBytes := fgRowBytes;
  1124.             xLines := bottom - top;
  1125.             xPixelsPerLine := right - left;
  1126.             BytesPerLine := xPixelsPerLine * 2;
  1127.         end; {with}
  1128.     for i := 0 to BytesPerLine - 1 do
  1129.         BlankLine[i] := WhiteIndex;
  1130.     dst := SumBase;
  1131.     for line := 1 to xLines do begin {zero buffer}
  1132.             BlockMove(@BlankLine, dst, BytesPerLine);
  1133.             dst := ptr(ord4(dst) + BytesPerLine);
  1134.         end;
  1135.     info^.title := 'Camera';
  1136.     UpdateTitleBar;
  1137.     StartTicks := TickCount;
  1138.     if VideoRateAveraging then begin
  1139.             if FramesToAverage > MaxLG3Frames then
  1140.                 FramesToAverage := MaxLG3Frames;
  1141.             ExternalTrigger := false;
  1142.             BufferReg^ := 0;
  1143.             GetFrame;
  1144.             StartTicks := TickCount - 2;
  1145.             for frame := 1 to FramesToAverage - 1 do begin
  1146.                     BufferReg^ := Frame;
  1147.                     GetFrame;
  1148.                 end;
  1149.             BufferReg^ := 0;
  1150.             RealToString((TickCount - StartTicks) / 60.0, 1, 2, str1);
  1151.             ShowFrameRate(concat(Long2str(FramesToAverage), ' frames', crStr, str1, ' seconds', crStr), StartTicks, FramesToAverage);
  1152.         end; {if VideoRateAveraging}
  1153.     for frame := 0 to FramesToAverage - 1 do begin
  1154.             Show2Values(frame + 1, FramesToAverage);
  1155.             if VideoRateAveraging then
  1156.                 BufferReg^ := Frame
  1157.             else begin
  1158.                 GetFrame;
  1159.                 if FrameGrabber = QTvdig then with info^ do
  1160.                 CopyOffScreen(fgPixMap, osPort^.portPixMap, roiRect, roiRect);
  1161.             end;
  1162.             src := srcbase;
  1163.             dst := SumBase;
  1164.             myMMUMode := 1;
  1165.             SwapMMUMode(myMMUMode);
  1166.             for line := 1 to xLines do begin
  1167.                     AddLineToSum(src, dst, xPixelsPerLine);
  1168.                     src := ptr(ord4(src) + SrcRowBytes);
  1169.                     dst := ptr(ord4(dst) + BytesPerLine);
  1170.                 end;
  1171.             SwapMMUMode(myMMUMode);
  1172.             if CommandPeriod then begin
  1173.                     beep;
  1174.                     if AutoSelectAll then
  1175.                         KillRoi
  1176.                     else
  1177.                         ShowRoi;
  1178.                     exit(AverageFrames);
  1179.                 end;
  1180.         end; {for}
  1181.     src := SumBase;
  1182.     dst := OffscreenBase;
  1183.     DstRowBytes := info^.BytesPerRow;
  1184.     if SumFrames then begin
  1185.             MinV := 2000000000;
  1186.             MaxV := 0;
  1187.             iptr := IntPtr(src);
  1188.             for i := 1 to SelectionSize do begin
  1189.                     value := iptr^;
  1190.                     if value > MaxV then
  1191.                         MaxV := value;
  1192.                     if value < MinV then
  1193.                         MinV := value;
  1194.                     iptr := IntPtr(ord4(iptr) + 2);
  1195.                 end;
  1196.             ActualMin := MinV;
  1197.             ActualMax := MaxV;
  1198.             if FixIntegrationScale then begin
  1199.                     MinV := IntegrationMin;
  1200.                     MaxV := IntegrationMax;
  1201.                 end;
  1202.             range := MaxV - MinV;
  1203.             if range <> 0 then
  1204.                 for line := 1 to xLines do begin
  1205.                         SumLine := sptr(src);
  1206.                         FrameLine := LinePtr(dst);
  1207.                         for j := 0 to xPixelsPerLine - 1 do begin
  1208.                                 value := ord4(SumLine^[j] - MinV) * 253 div range + 1;
  1209.                                 if value < 0 then
  1210.                                     value := 0;
  1211.                                 if value > 255 then
  1212.                                     value := 255;
  1213.                                 FrameLine^[j] := value;
  1214.                             end;
  1215.                         src := ptr(ord4(src) + BytesPerLine);
  1216.                         dst := ptr(ord4(dst) + DstRowBytes);
  1217.                     end
  1218.             else
  1219.                 beep;
  1220.         end
  1221.     else
  1222.         for line := 1 to xLines do begin
  1223.                 SumLine := sptr(src);
  1224.                 FrameLine := LinePtr(dst);
  1225.                 for j := 0 to xPixelsPerLine - 1 do
  1226.                     FrameLine^[j] := SumLine^[j] div FramesToAverage;
  1227.                 src := ptr(ord4(src) + BytesPerLine);
  1228.                 dst := ptr(ord4(dst) + DstRowBytes);
  1229.             end;
  1230.     if not VideoRateAveraging then begin
  1231.             if SumFrames then begin
  1232.                     if FixIntegrationScale then
  1233.                         str1 := concat('min=', long2str(MinV), ' (', long2str(ActualMin), ')', crStr, 'max=', long2str(MaxV), ' (', long2str(ActualMax), ')', crStr)
  1234.                     else
  1235.                         str1 := concat('min=', long2str(MinV), crStr, 'max=', long2str(MaxV), crStr)
  1236.                 end
  1237.             else
  1238.                 str1 := '';
  1239.             RealToString((TickCount - StartTicks) / 60.0, 1, 2, str2);
  1240.             ShowFrameRate(concat(Long2str(FramesToAverage), ' frames', crStr, str1, str2, ' seconds', crStr), StartTicks, FramesToAverage);
  1241.         end;
  1242.     UpdatePicWindow;
  1243.     if AutoSelectAll then
  1244.         KillRoi
  1245.     else
  1246.         ShowRoi;
  1247.     if BlankFieldInfo <> nil then
  1248.         CorrectShading;
  1249.     if ShowIntegratedValues then with info^ do begin
  1250.             fit := StraightLine;
  1251.             nCoefficients := 2;
  1252.             coefficient[2] := (MaxV - MinV) / 253.0;
  1253.             coefficient[1] := MinV - coefficient[2];
  1254.             nKnownValues := 0;
  1255.             ZeroClip := false;
  1256.             UpdateTitleBar;
  1257.             if macro then
  1258.                 GenerateValues;
  1259.         end else
  1260.             if SumFrames and (info^.fit<>uncalibrated) then
  1261.                 RemoveDensityCalibration;
  1262. end;
  1263.  
  1264.  
  1265. function GetFGPixel (h, v: integer): integer;
  1266.     var
  1267.         offset: LongInt;
  1268.         p: ptr;
  1269. begin
  1270.     if FrameGrabber = QTvdig then begin
  1271.         GetFGPixel := 0;
  1272.         exit(GetFGPixel);
  1273.     end;
  1274.     with Info^ do begin
  1275.             if (h < 0) or (v < 0) or (h >= fgWidth) or (v >= fgHeight) then begin
  1276.                     GetFGPixel := WhiteIndex;
  1277.                     exit(GetFGPixel);
  1278.                 end;
  1279.             offset := ord4(v) * fgRowBytes + h;
  1280.             if offset >= ord4(fgHeight) * fgRowBytes then begin
  1281.                     GetFGPixel := WhiteIndex;
  1282.                     exit(GetFGPixel);
  1283.                 end;
  1284.                 p := ptr(ord4(ptr(fgSlotBase)) + offset);
  1285.             GetFGPixel := BAND(p^, 255);
  1286.         end;
  1287. end;
  1288.  
  1289.  
  1290. procedure WaitForTrigger;
  1291. begin
  1292.     StopDigitizing;
  1293.     ShowWatch;
  1294.     case FrameGrabber of
  1295.         QuickCapture:  begin
  1296.                 ControlReg^ := BitAnd($82, 255);  {Wait for external trigger and capture one frame}
  1297.                 repeat
  1298.                 until (BitAnd(ControlReg^, $80) = $00) or Button;  {Wait for it to complete}
  1299.             end;
  1300.         ScionLG3, ScionAg5, ScionVG5f:  begin
  1301.                 ControlReg^ := $90; {Wait for external trigger and capture one frame}
  1302.                 repeat
  1303.                 until (BitAnd(ControlReg^, $80) = $80) or Button;  {Wait for it to complete}
  1304.             end;
  1305.         otherwise
  1306.             repeat
  1307.             until Button;
  1308.     end;
  1309. end;
  1310.  
  1311.  
  1312. procedure DoVideoSettingsDialog;
  1313. {Displays QuickTime video digitizer options dialog box}
  1314.     const
  1315.         grayID = 6;
  1316.         color8ID = 7;
  1317.         color24ID = 8;
  1318.         fullID = 10;
  1319.         oneHalfID = 11;
  1320.         oneQuarterID = 12;
  1321.         ntscID = 14;
  1322.         palID = 15;
  1323.         secamID =16;
  1324.         builtinID = 17;
  1325.         sVideoID = 18;
  1326.     var
  1327.         mylog: DialogPtr;
  1328.         item, ignore: integer;
  1329.         saveScale: integer;
  1330.         saveBuiltin, sVideo: boolean;
  1331.         wasDigitizing, WindowClosed, vdigError: boolean;
  1332.         saveStandard: VideoDigitizerStandard;
  1333.         saveMode: VideoDigitizerMode;
  1334.         
  1335.     procedure SetCaptureModeButtons;
  1336.     begin
  1337.         SetDlogItem(mylog, grayID, ord(DigitizerMode = digitizeGrayscale));
  1338.         SetDlogItem(mylog, color8ID, ord(DigitizerMode = digitizeColor));
  1339.         SetDlogItem(mylog, color24ID, ord(DigitizerMode = digitizeRGB));
  1340.     end;
  1341.  
  1342.     procedure SetSizeButtons;
  1343.     begin
  1344.         SetDlogItem(mylog, fullID, ord(fgScale = 1));
  1345.         SetDlogItem(mylog, oneHalfID, ord(fgScale = 2));
  1346.         SetDlogItem(mylog, oneQuarterID, ord(fgScale = 4));
  1347.     end;
  1348.  
  1349.     procedure SetStandardButtons;
  1350.     begin
  1351.         SetDlogItem(mylog, ntscID, ord((DigitizerStandard = defaultStd) or (DigitizerStandard = NTSCStd)));
  1352.         SetDlogItem(mylog, palID, ord(DigitizerStandard = palStd));
  1353.         SetDlogItem(mylog, secamID, ord(DigitizerStandard = secamStd));
  1354.     end;
  1355.     
  1356. begin
  1357.     saveScale := fgScale;
  1358.     saveBuiltIn := UseBuiltinDigitizer;
  1359.     saveMode := DigitizerMode;
  1360.     saveStandard := DigitizerStandard;
  1361.     sVideo := VideoChannel = 1;
  1362.     InitCursor;
  1363.     mylog := GetNewDialog(320, nil, pointer(-1));
  1364.     SetCaptureModeButtons;
  1365.     SetSizeButtons;
  1366.     SetStandardButtons;
  1367.     SetDlogItem(mylog, builtinID, ord(UseBuiltinDigitizer));
  1368.     SetDlogItem(mylog, sVideoID, ord(sVideo));
  1369.     repeat
  1370.         ModalDialog(nil, item);
  1371.         if item = grayID then begin
  1372.             DigitizerMode := digitizeGrayscale;
  1373.             SetCaptureModeButtons;
  1374.         end;
  1375.         if item = color8ID then begin
  1376.             DigitizerMode := digitizeColor;
  1377.             SetCaptureModeButtons;
  1378.         end;
  1379.         if item = color24ID then begin
  1380.             DigitizerMode := digitizeRGB;
  1381.             SetCaptureModeButtons;
  1382.         end;
  1383.         if item = fullID then begin
  1384.             fgScale := 1;
  1385.             SetSizeButtons;
  1386.         end;
  1387.         if item = oneHalfID then begin
  1388.             fgScale := 2;
  1389.             SetSizeButtons;
  1390.         end;
  1391.         if item = oneQuarterID then begin
  1392.             fgScale := 4;
  1393.             SetSizeButtons;
  1394.         end;
  1395.         if item = ntscID then begin
  1396.             DigitizerStandard := ntscStd;
  1397.             SetStandardButtons;
  1398.         end;
  1399.         if item = palID then begin
  1400.             DigitizerStandard := palStd;
  1401.             SetStandardButtons;
  1402.         end;
  1403.         if item = secamID then begin
  1404.             DigitizerStandard := secamStd;
  1405.             SetStandardButtons;
  1406.         end;
  1407.         if item = builtinID then begin
  1408.             UseBuiltinDigitizer := not UseBuiltinDigitizer;
  1409.             SetDlogItem(mylog, builtinID, ord(UseBuiltinDigitizer));
  1410.         end;
  1411.         if item = sVideoID then begin
  1412.             sVideo := not sVideo;
  1413.             SetDlogItem(mylog, sVideoID, ord(sVideo));
  1414.         end;
  1415.     until (item = ok) or (item = cancel);
  1416.     DisposeDialog(mylog);
  1417.     if item = cancel then begin
  1418.         fgScale := saveScale;
  1419.         UseBuiltinDigitizer := saveBuiltIn;
  1420.         DigitizerMode := saveMode;
  1421.         DigitizerStandard := saveStandard;
  1422.         exit(DoVideoSettingsDialog);
  1423.     end;
  1424.     if sVideo then
  1425.         VideoChannel := 1
  1426.     else
  1427.         VideoChannel := 0;
  1428.     wasDigitizing := digitizing;
  1429.     StopDigitizing;
  1430.     WindowClosed := false;
  1431.     CloseVdig;
  1432.     if (fgScale <> saveScale) or (UseBuiltinDigitizer <> saveBuiltIn) or (DigitizerStandard <> saveStandard) then begin
  1433.         SelectCameraWindow;
  1434.         with info^ do if PictureType = FrameGrabberType then begin
  1435.             changes := false;
  1436.             ignore := CloseAWindow(wptr);
  1437.             WindowClosed := true;
  1438.         end;
  1439.     end;
  1440.     if FrameGrabber = NoFrameGrabber then
  1441.         LookForVDig(vdigError);
  1442.     if wasDigitizing or WindowClosed then
  1443.         StartDigitizing;
  1444. end;
  1445.  
  1446.  
  1447. procedure SetOffset (var offset, gain: integer);
  1448. begin
  1449.     if offset < 0 then
  1450.         offset := 0;
  1451.     if offset > 255 then
  1452.         offset := 255;
  1453.     if offset > gain then
  1454.         offset := gain;
  1455.     DacLow := offset;
  1456.     DacHigh := DacLow + (255 - gain);
  1457. end;
  1458.  
  1459.  
  1460. procedure SetGain (var offset, gain: integer);
  1461. begin
  1462.     if gain < 0 then
  1463.         gain := 0;
  1464.     if gain > 255 then
  1465.         gain := 255;
  1466.     if gain < DacLow then
  1467.         gain := DacLow;
  1468.     DacHigh := DacLow + (255 - gain);
  1469. end;
  1470.  
  1471.  
  1472. procedure ShowChannel;
  1473. begin
  1474.     SetDlogItem(VideoControl, FirstChannelID, ord(VideoChannel = 0));
  1475.     SetDlogItem(VideoControl, FirstChannelID + 1, ord(VideoChannel = 1));
  1476.     SetDlogItem(VideoControl, FirstChannelID + 2, ord(VideoChannel = 2));
  1477.     SetDlogItem(VideoControl, FirstChannelID + 3, ord(VideoChannel = 3));
  1478. end;
  1479.  
  1480.  
  1481. procedure UpdateVideoControl;
  1482. begin
  1483.     if VideoControl <> nil then
  1484.         SetDlogItem(VideoControl, TriggerID, ord(ExternalTrigger));
  1485. end;
  1486.  
  1487.  
  1488. procedure ShowOffsetAndGain (offset, gain: integer);
  1489.     var
  1490.         str: str255;
  1491. begin
  1492.     RealToString(offset, 3, 0, str);
  1493.     if str[1] = ' ' then
  1494.         str[1] := '0';
  1495.     if str[2] = ' ' then
  1496.         str[2] := '0';
  1497.     SetDString(VideoControl, OffsetID, str);
  1498.     RealToString(gain, 3, 0, str);
  1499.     if str[1] = ' ' then
  1500.         str[1] := '0';
  1501.     if str[2] = ' ' then
  1502.         str[2] := '0';
  1503.     SetDString(VideoControl, GainID, str);
  1504. end;
  1505.  
  1506.  
  1507. procedure ShowVideoControl;
  1508.     var
  1509.         gain: integer;
  1510. begin
  1511.     InitCursor;
  1512.     VideoControl := GetNewDialog(130, nil, pointer(-1));
  1513.     ShowChannel;
  1514.     SetDlogItem(VideoControl, InvertID, ord(InvertVideo));
  1515.     SetDlogItem(VideoControl, HighlightID, ord(HighlightSaturatedPixels));
  1516.     SetDlogItem(VideoControl, TriggerID, ord(ExternalTrigger));
  1517.     SetDlogItem(VideoControl, SyncID, ord(SyncMode = SeparateSync));
  1518.     gain := 255 - (DacHigh - DacLow);
  1519.     ShowOffsetAndGain(DacLow, gain);
  1520. end;
  1521.  
  1522.  
  1523.     function NoScion:boolean;
  1524.     var
  1525.         NotFound:boolean;
  1526.     begin
  1527.         NotFound:=(FrameGrabber <> ScionLG3) and (FrameGrabber<>ScionAg5) and (FrameGrabber<>ScionVG5f);
  1528.         if NotFound then PutError('Programmable offset and gain are only supported on Scion frame grabbers.');
  1529.         NoScion:=NotFound;
  1530.     end;
  1531.  
  1532.  
  1533.     procedure DoVideoControl (item: integer);
  1534.     var
  1535.         i: integer;
  1536.         OutOfRange, WasDigitizing: boolean;
  1537.         offset, gain, inc, count: integer;
  1538.  
  1539.  
  1540.     procedure SetVideoItem (item, value: integer);
  1541.     begin
  1542.         if VideoControl <> nil then
  1543.             SetDlogItem(VideoControl, item, value);
  1544.     end;
  1545.  
  1546. begin
  1547.     InitCursor;
  1548.     gain := 255 - (DacHigh - DacLow);
  1549.     if (item >= FirstChannelID) and (item <= (FirstChannelID + 3)) then begin
  1550.             VideoChannel := item - FirstChannelID;
  1551.             if VideoControl <> nil then
  1552.                 ShowChannel;
  1553.             if digitizing then
  1554.                 ResetFrameGrabber;
  1555.         end;
  1556.     if item = InvertID then begin
  1557.             InvertVideo := not InvertVideo;
  1558.             SetVideoItem(InvertID, ord(InvertVideo));
  1559.             if digitizing then
  1560.                 ResetFrameGrabber;
  1561.         end;
  1562.     if item = HighlightID then begin
  1563.             HighlightSaturatedPixels := not HighlightSaturatedPixels;
  1564.             SetVideoItem(HighlightID, ord(HighlightSaturatedPixels));
  1565.             if digitizing then begin
  1566.                     if HighlightSaturatedPixels then
  1567.                         HighlightPixels
  1568.                     else
  1569.                         LoadLUT(info^.ctable);
  1570.                 end;
  1571.         end;
  1572.     if item = TriggerID then begin
  1573.             ExternalTrigger := not ExternalTrigger;
  1574.             case FrameGrabber of
  1575.                 QuickCapture, ScionLG3, ScionAG5, ScionVG5f:  begin
  1576.                         WasDigitizing := digitizing;
  1577.                         StopDigitizing;
  1578.                         if ExternalTrigger and WasDigitizing then
  1579.                             StartDigitizing;
  1580.                     end;
  1581.                 otherwise
  1582.                     ExternalTrigger := false;
  1583.             end;
  1584.             SetVideoItem(TriggerID, ord(ExternalTrigger));
  1585.         end;
  1586.     if item = SyncID then begin
  1587.             if SyncMode <> SeparateSync then
  1588.                 SyncMode := SeparateSync
  1589.             else
  1590.                 SyncMode := NormalSync;
  1591.             case FrameGrabber of
  1592.                 ScionLG3, ScionAG5, ScionVG5f: 
  1593.                     if digitizing then
  1594.                         ResetFrameGrabber;
  1595.                 QuickCapture:  begin
  1596.                         PutError('Sync is not under program control on the QuickCapure card.');
  1597.                         SyncMode := NormalSync;
  1598.                         AbortMacro;
  1599.                     end;
  1600.                 otherwise
  1601.                     ;
  1602.             end;
  1603.             SetVideoItem(SyncID, ord(SyncMode = SeparateSync));
  1604.         end;
  1605.     if (item >= OffsetUpID) and (item <= GainDownID) then begin
  1606.             if NoScion then exit(DoVideoControl);
  1607.             offset := DacLow;
  1608.             inc := 1;
  1609.             count := 0;
  1610.             repeat
  1611.                 count := count + 1;
  1612.                 if count > 2 then
  1613.                     inc := 2;
  1614.                 if count > 4 then
  1615.                     inc := 5;
  1616.                 if count > 8 then
  1617.                     inc := 10;
  1618.                 case item of
  1619.                     OffsetUpID:  begin
  1620.                             offset := offset + inc;
  1621.                             SetOffset(offset, gain);
  1622.                         end;
  1623.                     OffsetDownID:  begin
  1624.                             offset := offset - inc;
  1625.                             SetOffset(offset, gain);
  1626.                         end;
  1627.                     GainUpID:  begin
  1628.                             gain := gain + inc;
  1629.                             SetGain(offset, gain);
  1630.                         end;
  1631.                     GainDownID:  begin
  1632.                             gain := gain - inc;
  1633.                             SetGain(offset, gain);
  1634.                         end;
  1635.                 end; {case}
  1636.                 ShowOffsetAndGain(DacLow, gain);
  1637.                 if Digitizing and (count > 1) then begin
  1638.                         DacLowReg^ := DacLow;
  1639.                         DacHighReg^ := DacHigh;
  1640.                         CaptureAndDisplayFrame;
  1641.                         if ContinuousHistogram then begin
  1642.                                 ShowContinuousHistogram;
  1643.                                 DrawHistogram
  1644.                             end
  1645.                     end
  1646.                 else
  1647.                     wait(5);
  1648.             until not button;
  1649.         end;
  1650.     if item = ResetID then begin
  1651.             if NoScion then exit(DoVideoControl);
  1652.             DacLow := DefaultDacLow;
  1653.             DacHigh := DefaultDacHigh;
  1654.             gain := 255 - (DacHigh - DacLow);
  1655.             ParamText(long2str(DacLow), long2str(gain), '', '');
  1656.             ShowOffsetAndGain(DacLow, gain);
  1657.         end;
  1658.     if FramesToAverage < 2 then
  1659.         FramesToAverage := 2;
  1660.     if (FrameGrabber = ScionLG3) or (FrameGrabber=ScionAG5) or (FrameGrabber=ScionVG5f) then begin
  1661.             DacLowReg^ := DacLow;
  1662.             DacHighReg^ := DacHigh;
  1663.         end;
  1664. end;
  1665.  
  1666.  
  1667. procedure ShowVideoDialog;
  1668. var
  1669.     vdigError: boolean;
  1670. begin
  1671.     if FrameGrabber = noFrameGrabber then begin
  1672.         LookForVDig(vdigError);
  1673.         if vdigError then begin
  1674.             doVideoSettingsDialog;
  1675.             exit(ShowVideoDialog);
  1676.         end;
  1677.     end;
  1678.     if FrameGrabber = QTvdig then
  1679.         doVideoSettingsDialog
  1680.     else begin
  1681.         if VideoControl = nil then
  1682.             ShowVideoControl
  1683.         else
  1684.             SelectWindow(VideoControl);
  1685.     end;
  1686. end;
  1687.  
  1688. end.